home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / manchester / 2.3 / Form-fixes.st < prev    next >
Text File  |  1993-07-24  |  2KB  |  48 lines
  1. "    NAME        Form-fixes
  2.     AUTHOR        manchester
  3.     FUNCTION    ?
  4.     ST-VERSION    2.3
  5.     PREREQUISITES    
  6.     CONFLICTS
  7.     DISTRIBUTION    world
  8.     VERSION        1
  9.     DATE    22 Jan 1989"
  10. 'From Smalltalk-80, Version 2.3 of 13 June 1988 on 21 July 1989 at 12:18:55 pm'!
  11.  
  12.  
  13.  
  14. !InfiniteForm methodsFor: 'displaying'!
  15.  
  16. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm
  17.     "Display the receiver on the display medium aDisplayMedium positioned at aDisplayPoint within
  18.     the rectangle clipRectangle and with the rule, ruleInteger, and mask, aForm.  Bugs fixed so that aDisplayPoint
  19.     is taken into account, and infinite opaque forms work."
  20.  
  21.     | targetBox patternBox |
  22.     (aForm == Form black and: [patternForm class == Form and: [patternForm extent = (16 @ 16)]])
  23.         ifTrue:
  24.             ["Use patternForm as a mask for BitBlt"
  25.             aDisplayMedium fill: clipRectangle rule: ruleInteger mask: (patternForm wrapAround: aDisplayPoint)]
  26.         ifFalse:
  27.             ["Do it iteratively"
  28.             targetBox _ aDisplayMedium boundingBox intersect: clipRectangle.
  29.             patternBox _ patternForm boundingBox.
  30.             (targetBox left truncateTo: patternBox width) + (aDisplayPoint x \\ patternBox width) - patternBox width to: targetBox right - 1 by: patternBox width do:
  31.                 [:x |
  32.                 (targetBox top truncateTo: patternBox height) + (aDisplayPoint y \\ patternBox height) - patternBox height to: targetBox bottom - 1 by: patternBox height do:
  33.                     [:y |
  34.                     patternForm displayOn: aDisplayMedium
  35.                         at: x @ y
  36.                         clippingBox: clipRectangle
  37.                         rule: ruleInteger
  38.                         mask: aForm]]]!
  39.  
  40.  
  41. !OpaqueForm class methodsFor: 'instance creation'!
  42.  
  43. shape: aSolidForm
  44.     "Answer a new instance of the receiver that is black where aSolidForm is black
  45.     and transparent where aSolidForm is white."
  46.  
  47.      ^ self new setFigure: aSolidForm deepCopy shape: aSolidForm! !
  48.